home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / geodem / csc5.bas < prev    next >
BASIC Source File  |  1995-05-09  |  25KB  |  696 lines
  1. '3D CyberSpace viewer from...
  2.  
  3. 'Ivory Tower Software
  4. 'Richard Wagner
  5. 'CIS 76427,2611
  6.  
  7. 'Copyright 1992, all rights reserved.
  8.  
  9. 'You may use this VB source code in your programs if you include attribution in your
  10. 'startup and "about" screens in the form: "Portions of this program copyright by
  11. 'Ivory Tower Software, used with permission."
  12.  
  13.  
  14.  
  15. Sub BorderBoxRaised (Source1 As Control, Source2 As Form)
  16.  
  17.   Source2.drawwidth = 1
  18.   Bleft% = Source1.Left - 15
  19.   BTop% = Source1.top - 15
  20.   BWide% = Source1.width + 15
  21.   BHigh% = Source1.height + 15
  22.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), &HFFFFFF
  23.   Source2.Line -Step(0, BHigh%), 0
  24.   Source2.Line -Step(-BWide%, 0), 0
  25.   Source2.Line -Step(0, -BHigh%), &HFFFFFF
  26.  
  27. End Sub
  28.  
  29. Sub BorderBoxRecessed (Source1 As Control, Source2 As Form)
  30.  
  31.   Source2.drawwidth = 1
  32.   Bleft% = Source1.Left - 20
  33.   BTop% = Source1.top - 20
  34.   BWide% = Source1.width + 15
  35.   BHigh% = Source1.height + 15
  36.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), 0
  37.   Source2.Line -Step(0, BHigh%), &HFFFFFF
  38.   Source2.Line -Step(-BWide%, 0), &HFFFFFF
  39.   Source2.Line -Step(0, -BHigh%), 0
  40.  
  41. End Sub
  42.  
  43. Sub MapToWindow (ByVal PointNum As Integer, ByVal X, ByVal Y, ByVal Z)
  44.  
  45.     'Transform object point in World Space to View Space.
  46.     'Call GEO.DLL subroutine:
  47.     ThreeDXForm 1000, 1000, X, Y, Z, sfViewPointX, sfViewPointY, sfViewPointZ, sfWinPointX, sfWinPointY, sfWinPointZ, sfRPointX, sfRPointY, sfRPointZ, sfSPointX, sfSPointY, sfSPointZ, PxStar, PyStar, PzStar
  48.     
  49.     'Transform object point in View 3Space to Window 2Space:
  50.     If PzStar <> 0 Then
  51.       PxStar = -PxStar * 1000 / PzStar
  52.       PyStar = -PyStar * 1000 / PzStar
  53.     Else
  54.       PxStar = -PxStar * 1000 * 30000    'Can't divide by zero so
  55.       PyStar = -PyStar * 1000 * 30000    'do the next best thing
  56.     End If
  57.  
  58.     'Convert mapped points to integers for drawing:
  59.     If PxStar <= 30000 And PxStar >= -30000 Then
  60.       iPx(PointNum) = CInt(PxStar)
  61.     Else
  62.       iPx(PointNum) = 30000 * Sgn(PxStar)
  63.     End If
  64.  
  65.     If PyStar <= 30000 And PyStar >= -30000 Then
  66.       iPy(PointNum) = CInt(PyStar)
  67.     Else
  68.       iPy(PointNum) = 30000 * Sgn(PyStar)
  69.     End If
  70.  
  71.     If PzStar <= 30000 And PzStar >= -30000 Then
  72.       iPz(PointNum) = CInt(PzStar)
  73.     Else
  74.       iPz(PointNum) = 30000 * Sgn(PzStar)
  75.     End If
  76.  
  77. End Sub
  78.  
  79. Sub PicBorderBoxRecessed (Source1 As Control, Source2 As Control)
  80.  
  81.   Source2.drawwidth = 1
  82.   Bleft% = Source1.Left - 15
  83.   BTop% = Source1.top - 15
  84.   BWide% = Source1.width + 15
  85.   BHigh% = Source1.height + 15
  86.   Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), 0
  87.   Source2.Line -Step(0, BHigh%), &HFFFFFF
  88.   Source2.Line -Step(-BWide%, 0), &HFFFFFF
  89.   Source2.Line -Step(0, -BHigh%), 0
  90.  
  91. End Sub
  92.  
  93. Sub PlaceAllObjects ()
  94.   
  95.   'All the defined objects get placed in cyberspace, with more distant objects
  96.   'getting placed first.
  97.   
  98.   XView.mousepointer = 11
  99.  
  100.   For i% = 1 To iNumObjects
  101.    'Find distances squared of objects' centers from ViewPoint:
  102.    'There is no need to take the square root, because it's the distance order we want.
  103.     
  104.     sfDSquared(i%) = (iLocationX(i%) - sfViewPointX) ^ 2 + (iLocationY(i%) - sfViewPointY) ^ 2 + (iLocationZ(i%) - sfViewPointZ) ^ 2
  105.     
  106.     'Initialize object order array:
  107.     iObjOrder(i%) = i%
  108.   Next i%
  109.  
  110.   'Sort objects by their distances squared:
  111.   'Bubble sort
  112.   For i% = 1 To iNumObjects - 1
  113.     For j% = i% + 1 To iNumObjects
  114.       If sfDSquared(i%) < sfDSquared(j%) Then
  115.         
  116.         Temp1! = sfDSquared(i%)
  117.         sfDSquared(i%) = sfDSquared(j%)
  118.         sfDSquared(j%) = Temp1!
  119.  
  120.         Temp2! = iObjOrder(i%)
  121.         iObjOrder(i%) = iObjOrder(j%)
  122.         iObjOrder(j%) = Temp2!
  123.   
  124.       End If
  125.     Next j%
  126.   Next i%
  127.  
  128.   For i% = 1 To iNumObjects
  129.     'See if center of object is outside view pyramid by 500 CLUs:
  130.     'Objects completely out of view don't get drawn.
  131.     'This means that the biggest object in cyberspace cannot be bigger than
  132.     '1000 CLUs in any dimension.
  133.     NewX! = iLocationX(i%) - sfViewPointX
  134.     NewY! = iLocationY(i%) - sfViewPointY
  135.     NewZ! = iLocationZ(i%) - sfViewPointZ
  136.     CenterXstar& = (sfRPointX - sfWinPointX) * NewX! / 500 + (sfRPointY - sfWinPointY) * NewY! / 500 + (sfRPointZ - sfWinPointZ) * NewZ! / 500
  137.     CenterYstar& = (sfSPointX - sfWinPointX) * NewX! / 500 + (sfSPointY - sfWinPointY) * NewY! / 500 + (sfSPointZ - sfWinPointZ) * NewZ! / 500
  138.     CenterZstar& = (sfViewPointX - sfWinPointX) * NewX! / 1000 + (sfViewPointY - sfWinPointY) * NewY! / 1000 + (sfViewPointZ - sfWinPointZ) * NewZ! / 1000
  139.     iInView(i%) = -1
  140.     If CenterXstar& > (1000 - CenterZstar&) / 2 Then
  141.       iInView(i%) = 0
  142.     End If
  143.     If CenterXstar& < (CenterZstar& - 1000) / 2 Then
  144.       iInView(i%) = 0
  145.     End If
  146.     If CenterYstar& > (1000 - CenterZstar&) / 2 Then
  147.       iInView(i%) = 0
  148.     End If
  149.     If CenterYstar& < (CenterZstar& - 1000) / 2 Then
  150.        iInView(i%) = 0
  151.     End If
  152.  
  153.   Next i%
  154.  
  155.   For i% = 1 To iNumObjects
  156.  
  157.     'Erase
  158.     'Objects are explicitly erased for smooth drawing.
  159.     If iInViewPrev(iObjOrder(i%)) Then PlaceObject iObjOrder(i%), -1
  160.   
  161.   Next i%
  162.  
  163.   For i% = 1 To iNumObjects
  164.     
  165.     'Place
  166.     If iInView(iObjOrder(i%)) Then PlaceObject iObjOrder(i%), 0
  167.     iInViewPrev(i%) = iInView(i%)
  168.  
  169.   Next i%
  170.   XView.mousepointer = 0
  171.  
  172. End Sub
  173.  
  174. Sub PlaceObject (ObjNum As Integer, iErase As Integer)
  175.  
  176.   'Each object is placed separately after erasing its old placement.
  177.   'Cls is not used because that makes a flickering view port.
  178.  
  179.   On Error GoTo PlaceObjectHandler
  180.   
  181. If Not iErase Then                      'Placing objects, so calculate transformations:
  182.  
  183.   For i% = 1 To iNumPoints(iObjectType(ObjNum))      'Do it for each point in the object:
  184.     
  185.     'Point is referenced to iLocationX, Y, Z of object center relative to the viewpoint:
  186.     NewX! = iObjectX(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationX(ObjNum) - sfViewPointX
  187.     NewY! = iObjectY(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationY(ObjNum) - sfViewPointY
  188.     NewZ! = iObjectZ(iObjectType(ObjNum), i%) * sfSize(ObjNum) + iLocationZ(ObjNum) - sfViewPointZ
  189.     
  190.     MapToWindow i%, NewX!, NewY!, NewZ!
  191.  
  192.   Next i%
  193.  
  194. End If
  195.  
  196. 'Each object is drawn depending on its type:
  197. Select Case iObjectType(ObjNum)
  198.  
  199. Case 1, 44                     'Wireframe Cube
  200.  
  201. If iErase Then              'Erase previous rendering of the object:
  202.                             '(doing CLS makes a jumpy flickering picture)
  203.     
  204.     If PzOld(ObjNum, 1) < 0 Or PzOld(ObjNum, 2) < 0 Then
  205.       If (Abs(PxOld(ObjNum, 1)) < 500 And Abs(PyOld(ObjNum, 1)) < 500) Or (Abs(PxOld(ObjNum, 2)) < 500 And Abs(PyOld(ObjNum, 2)) < 500) Then
  206.         XView.ViewPic.Line (PxOld(ObjNum, 1), PyOld(ObjNum, 1))-(PxOld(ObjNum, 2), PyOld(ObjNum, 2)), QBColor(7)
  207.       End If
  208.     End If
  209.     If PzOld(ObjNum, 2) < 0 Or PzOld(ObjNum, 3) < 0 Then
  210.       If (Abs(PxOld(ObjNum, 2)) < 500 And Abs(PyOld(ObjNum, 2)) < 500) Or (Abs(PxOld(ObjNum, 3)) < 500 And Abs(PyOld(ObjNum, 3)) < 500) Then
  211.         XView.ViewPic.Line (PxOld(ObjNum, 2), PyOld(ObjNum, 2))-(PxOld(ObjNum, 3), PyOld(ObjNum, 3)), QBColor(7)
  212.       End If
  213.     End If
  214.     If PzOld(ObjNum, 3) < 0 Or PzOld(ObjNum, 4) < 0 Then
  215.       If (Abs(PxOld(ObjNum, 3)) < 500 And Abs(PyOld(ObjNum, 3)) < 500) Or (Abs(PxOld(ObjNum, 4)) < 500 And Abs(PyOld(ObjNum, 4)) < 500) Then
  216.         XView.ViewPic.Line (PxOld(ObjNum, 3), PyOld(ObjNum, 3))-(PxOld(ObjNum, 4), PyOld(ObjNum, 4)), QBColor(7)
  217.       End If
  218.     End If
  219.     If PzOld(ObjNum, 4) < 0 Or PzOld(ObjNum, 1) < 0 Then
  220.       If (Abs(PxOld(ObjNum, 4)) < 500 And Abs(PyOld(ObjNum, 4)) < 500) Or (Abs(PxOld(ObjNum, 1)) < 500 And Abs(PyOld(ObjNum, 1)) < 500) Then
  221.         XView.ViewPic.Line (PxOld(ObjNum, 4), PyOld(ObjNum, 4))-(PxOld(ObjNum, 1), PyOld(ObjNum, 1)), QBColor(7)
  222.       End If
  223.     End If
  224.     If PzOld(ObjNum, 5) < 0 Or PzOld(ObjNum, 6) < 0 Then
  225.       If (Abs(PxOld(ObjNum, 5)) < 500 And Abs(PyOld(ObjNum, 5)) < 500) Or (Abs(PxOld(ObjNum, 6)) < 500 And Abs(PyOld(ObjNum, 6)) < 500) Then
  226.         XView.ViewPic.Line (PxOld(ObjNum, 5), PyOld(ObjNum, 5))-(PxOl